# functions that deal with the analysis of the results of learning algorithms
# calculates the RMSE between two vectors
RMSE <- function(v1, v2) {
  i1 <- which(!is.na(v1))
  i2 <- which(!is.na(v2))
  is <- intersect(i1, i2)
  v1 <- v1[is]
  v2 <- v2[is]
  residuals <- abs(v1-v2)
  return(sqrt( (residuals%*%residuals)/length(v1) ))
}

# calculates the MAE between two vectors
MAE <- function (v1, v2) {
  i1 <- which(!is.na(v1))
  i2 <- which(!is.na(v2))
  is <- intersect(i1, i2)
  v1 <- v1[is]
  v2 <- v2[is]
  residuals <- abs(v1 - v2)
  return(sum(residuals)/length(v1))
}

# Tropsha's Statistics for Model Assessment
# Tropsha, A.; Golbraikh, A. Predictive Quantitative Structure–Activity Relationships Modeling: 
#Development and Validation of QSAR Models. In: Handbook of Chemoinformatics Algorithms 
#(Faulon, J.-L.; Bender, A., Eds.), Chapter 7, pp. 213-233, Chapman & Hall / CRC, London, UK, 2010.

# Calculates the slope between two vector (k')
slope <- function(v1,v2){ # v1=z.test v2=y.test
  return(sum(v2*v1)/sum(v1*v1))
}

# Calculates the regression coefficient through the origin
Rsquared0 <- function(v1,v2) { #v1=z.test (y), v2=y.test (x)
  if (is.vector(v1) && is.vector(v2) && length(v1)==length(v2)){
  y_obs_mean <- mean(v2)
  yr0 = v1 * slope(v1,v2)
  first_term = (v2 - yr0)*(v2 - yr0)
  second_term= (v2-y_obs_mean)*(v2-y_obs_mean)
  return(1-(sum(first_term)/sum(second_term)))
  }
  else {print("Wrong input: input arguments are not vector or have unequal length")}
}


# Calculates the regression coefficient 
Rsquared <- function(v1,v2) { # v1=z.test (y), v2=y.test (x)
  if (is.vector(v1) && is.vector(v2) && length(v1)==length(v2)){
  y_obs_mean <- mean(v2)
  y_pred_mean <- mean(v1)
  first_term <- sum((v2-y_obs_mean) * (v1 - y_pred_mean))
  second_term <- sqrt(sum((v2-y_obs_mean)*(v2-y_obs_mean)) * sum((v1 - y_pred_mean)*(v1 - y_pred_mean)))
  division <- first_term / second_term
  return(division * division)
  }
  else {print("Wrong input: input arguments are not vector or have unequal length")}
  
}

# Calculates the Q squared 
#Qsquared (z.test,y.test) (predicted vs observed)
Qsquared <- function(v1, v2) {
  if (is.vector(v1) && is.vector(v2) && length(v1)==length(v2)){
  y_obs_mean <- mean(v2)
  first_term <- abs(v1-v2)*abs(v1-v2)
  second_term <- abs(v2-y_obs_mean)*abs(v2-y_obs_mean)
  return(1-(sum(first_term)/sum(second_term)))
  }
  else {print("Wrong input: input arguments are not vector or have unequal length")}
}

################################


# Plot erros bars
error.bar <- function(x, y, upper, lower=upper, length=0.1,...){
  if(length(x) != length(y) | length(y) !=length(lower) | length(lower) != length(upper))
    stop("vectors must be same length")
  arrows(x,y+upper, x, y-lower, angle=90, code=3, length=length, ...)
}


# Euclidean Distance of two vectors
euc.dist <- function(x1,x2){
  if (is.vector(v1) && is.vector(v2) && length(v1)==length(v2)){
  return(sqrt(sum((x1 - x2) ^ 2)))
  }
  else {print("Wrong input: input arguments are not vector or have unequal length")}
}

# Tanimoto Distance between two vectors
tani <- function(a,b){  
  if (length(a) != length(b)){print("vectors of unqual length");break}
  differentes = sum((a == b)*1) 
  comunes = length(a)
  tani =  differentes / comunes
  return(tani)
}

###############################################################
############## Kernels ########################################
###############################################################

require(kernlab)
# Pearson VII PUK Kernel
puk<- function(sigma=1, omega =1) 
{
  rval <- function(x,y=NULL)   
  {    
    if(!is(x,"vector")) stop("x must be a vector")    
    if(!is(y,"vector")&&!is.null(y)) stop("y must a vector")   
    if (is(x,"vector") && is.null(y)){      
      return(1)     
    }    
    if (is(x,"vector") && is(y,"vector")){      
      if (!length(x)==length(y))        
        stop("number of dimension must be the same on both data points")            
      return(1/((1 + ((2*(sqrt(((2*crossprod(x,y) - crossprod(x) - crossprod(y))^2 * sqrt(2^(1/omega) -1)))))/sigma)^2))^ omega)      
    }   
  }  
  return(new("puk",.Data=rval,kpar=list(sigma=sigma,omega=omega)))  
}
setClass("puk",prototype=structure(.Data=function(){},kpar=list()),contains=c("kernel"))
############################################################
############################################################

# Normalized Polynomial Kernel
require(kernlab)
pndot<- function(degree=1,scale=1)
{
  
  rval <- function(x,y=NULL)
  {
    if(!is(x,"vector")) stop("x must be a vector")
    if(!is(y,"vector")&&!is.null(y)) stop("y must a vector")
    if (is(x,"vector") && is.null(y)){
      return(1)
    }
    if (is(x,"vector") && is(y,"vector")){
      if (!length(x)==length(y))
        stop("number of dimension must be the same on both data points")
      return (((scale*crossprod(x,y))^degree) / (sqrt( (scale*crossprod(x,x))^degree * (scale*crossprod(y,y))^degree )))
    }
  }
  return(new("pnkernel",.Data=rval,kpar=list(degree=degree,scale=scale)))
}
setClass("pnkernel",prototype=structure(.Data=function(){},kpar=list()),contains=c("kernel"))
############################################################
############################################################


